home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / srfi / srfi-34.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  3.0 KB  |  81 lines
  1. ;;; srfi-34.scm --- Exception handling for programs
  2.  
  3. ;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
  4. ;;
  5. ;; This library is free software; you can redistribute it and/or
  6. ;; modify it under the terms of the GNU Lesser General Public
  7. ;; License as published by the Free Software Foundation; either
  8. ;; version 2.1 of the License, or (at your option) any later version.
  9. ;; 
  10. ;; This library is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;; Lesser General Public License for more details.
  14. ;; 
  15. ;; You should have received a copy of the GNU Lesser General Public
  16. ;; License along with this library; if not, write to the Free Software
  17. ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18.  
  19. ;;; Author: Neil Jerram <neil@ossau.uklinux.net>
  20.  
  21. ;;; Commentary:
  22.  
  23. ;; This is an implementation of SRFI-34: Exception Handling for
  24. ;; Programs.  For documentation please see the SRFI-34 document; this
  25. ;; module is not yet documented at all in the Guile manual.
  26.  
  27. ;;; Code:
  28.  
  29. (define-module (srfi srfi-34)
  30.   #:export (with-exception-handler
  31.         raise)
  32.   #:export-syntax (guard))
  33.  
  34. (cond-expand-provide (current-module) '(srfi-34))
  35.  
  36. (define throw-key 'srfi-34)
  37.  
  38. (define (with-exception-handler handler thunk)
  39.   "Returns the result(s) of invoking THUNK. HANDLER must be a
  40. procedure that accepts one argument.  It is installed as the current
  41. exception handler for the dynamic extent (as determined by
  42. dynamic-wind) of the invocation of THUNK."
  43.   (lazy-catch throw-key
  44.           thunk
  45.           (lambda (key obj)
  46.         (handler obj))))
  47.  
  48. (define (raise obj)
  49.   "Invokes the current exception handler on OBJ.  The handler is
  50. called in the dynamic environment of the call to raise, except that
  51. the current exception handler is that in place for the call to
  52. with-exception-handler that installed the handler being called.  The
  53. handler's continuation is otherwise unspecified."
  54.   (throw throw-key obj))
  55.  
  56. (define-macro (guard var+clauses . body)
  57.   "Syntax: (guard (<var> <clause1> <clause2> ...) <body>)
  58. Each <clause> should have the same form as a `cond' clause.
  59.  
  60. Semantics: Evaluating a guard form evaluates <body> with an exception
  61. handler that binds the raised object to <var> and within the scope of
  62. that binding evaluates the clauses as if they were the clauses of a
  63. cond expression.  That implicit cond expression is evaluated with the
  64. continuation and dynamic environment of the guard expression.  If
  65. every <clause>'s <test> evaluates to false and there is no else
  66. clause, then raise is re-invoked on the raised object within the
  67. dynamic environment of the original call to raise except that the
  68. current exception handler is that of the guard expression."
  69.   (let ((var (car var+clauses))
  70.     (clauses (cdr var+clauses)))
  71.     `(catch ',throw-key
  72.         (lambda ()
  73.           ,@body)
  74.         (lambda (key ,var)
  75.           (cond ,@(if (eq? (caar (last-pair clauses)) 'else)
  76.               clauses
  77.               (append clauses
  78.                   `((else (throw key ,var))))))))))
  79.  
  80. ;;; (srfi srfi-34) ends here.
  81.